home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / Float source / fValue < prev   
Text File  |  1992-05-27  |  3KB  |  68 lines
  1. \ Fvalue -- support for floating-point analogs of Value and Constant
  2. \  9/24/85  cbd Version 1.0
  3. \ 11/19/91    rfl    change 0 >float to 0. at end to avoid using >float. Then
  4. \               7.0.1 quickfix works, since don't want to execute any pack4 yet
  5. \  5/27/92    rfl    moved fpmodel stuff to finterpret source; needed finterpret running
  6.  
  7. \ ========= Code support for Values - CBD 9/85 ======
  8. :CODE  flt@     \ fvalue 0cfa code
  9.         move.l  YERK[(fltNew)],d7
  10.         jsr     0(a3,d7.l)          ; get new float in d1
  11.         lea     12(a3,d6.l),a0      ; get the data addr from WP
  12.         lea     2(a3,d1.l),a1 
  13.         move.l  (a0)+,(a1)+         ; copy float data
  14.         move.l  (a0)+,(a1)+       
  15.         move.w  (a0)+,(a1)+   
  16.         move.l  d1,-(a7)            ; return new float
  17. ;CODE  
  18.  
  19. :CODE  flt++    \ 1cfa code
  20.         move.l  d6,a2           ; get base address from WP
  21.         addq.l   #6,a2          ; 2 bytes before data to simulate flt
  22.         move.l  (a7),d0         ; get parm
  23.         move.l  a2,(a7)         ; put rcvr under parm
  24.         move.l  d0,-(a7)        ; push parm
  25.         move.l  YERK[(fp1)],d7     ; get subr addr in d7
  26.         jsr     0(a3,d7.l)      ; go setup stack
  27.         clr.w   -(A7)           ; code for FADD
  28.         call pack4           
  29. ;CODE         
  30.   
  31. :CODE  flt!     \ 2cfa code
  32.         move.l  (a7),d0             ; set up for dispose of float
  33.         move.l  YERK[(fltDisp)],d7
  34.         jsr     0(a3,d7.l)          ; kill float in D0
  35.         lea     4(a3,d6.l),a1       ; base address
  36.         move.l  (a7)+,d0            ; new value for data
  37.         lea     2(a3,d0.l),a0       ; 
  38.         move.l  (a0)+,(a1)+         ; copy float data
  39.         move.l  (a0)+,(a1)+       
  40.         move.w  (a0)+,(a1)+   
  41. ;CODE   
  42.  
  43. \ Write a float into dictionary: analogous to , or c, .
  44. ( flt -- )
  45. : f,   dup 2+ here 10 cmove 10 allot fdrop    ;
  46.  
  47. \ Define Fvalue as an mcfa word
  48. : fValue  create -4 allot ' flt@ , ' flt++ ,  ' flt! ,  f,  ; 
  49.         
  50. \ code for floating point constants
  51. :CODE  fcon@     \ fvalue 0cfa code
  52.         move.l  YERK[(fltNew)],d7
  53.         jsr     0(a3,d7.l)          ; get new float in d1
  54.         lea     4(a3,d6.l),a0       ; get the data addr from WP
  55.         lea     2(a3,d1.l),a1 
  56.         move.l  (a0)+,(a1)+         ; copy float data
  57.         move.l  (a0)+,(a1)+       
  58.         move.w  (a0)+,(a1)+   
  59.         move.l  d1,-(a7)            ; return new float
  60. ;CODE  
  61.  
  62. : fCon  create -4 allot  ' fcon@ , f,  ;   
  63.  
  64. \ do after installing finterpret
  65. \ 0. fvalue fpmodel
  66. \ 
  67. \ 'code fpmodel -> fvalcode       \ patch value in Args file
  68.